home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / opbonus.arc / ENTRYL.ARC / ENTRYL.PAS next >
Pascal/Delphi Source File  |  1991-03-20  |  6KB  |  248 lines
  1. {$V-}
  2.  
  3. program ENTRYL;
  4.  
  5. {$I OPDEFINE.INC}
  6.  
  7. {$DEFINE TestStream}
  8.  
  9. uses
  10.   Dos,
  11.   OpDos,
  12.   OpInline,
  13.   OpString,
  14.   OpRoot,
  15.   OpCrt,
  16.   {$IFDEF UseMouse}
  17.   OpMouse,
  18.   {$ENDIF}
  19.   OpAbsFld,
  20.   OpCmd,
  21.   OpField,
  22.   OpFrame,
  23.   OpWindow,
  24.   OpSelect,
  25.   OpEntry;
  26.  
  27.   {$IFDEF UseMouse}
  28. const
  29.   MouseChar  : Char = #04;
  30.   {$ENDIF}
  31.  
  32. {Color set used by entry screen}
  33. const
  34.   EsColors : ColorSet = (
  35.     TextColor       : $1E; TextMono        : $0F;
  36.     CtrlColor       : $1E; CtrlMono        : $0F;
  37.     FrameColor      : $1F; FrameMono       : $0F;
  38.     HeaderColor     : $3F; HeaderMono      : $70;
  39.     ShadowColor     : $08; ShadowMono      : $0F;
  40.     HighlightColor  : $4F; HighlightMono   : $70;
  41.     PromptColor     : $1F; PromptMono      : $07;
  42.     SelPromptColor  : $1F; SelPromptMono   : $07;
  43.     ProPromptColor  : $17; ProPromptMono   : $07;
  44.     FieldColor      : $1E; FieldMono       : $07;
  45.     SelFieldColor   : $31; SelFieldMono    : $0F;
  46.     ProFieldColor   : $17; ProFieldMono    : $07;
  47.     ScrollBarColor  : $13; ScrollBarMono   : $07;
  48.     SliderColor     : $13; SliderMono      : $0F;
  49.     HotSpotColor    : $30; HotSpotMono     : $70;
  50.     BlockColor      : $3E; BlockMono       : $0F;
  51.     MarkerColor     : $3F; MarkerMono      : $70;
  52.     DelimColor      : $1E; DelimMono       : $0F;
  53.     SelDelimColor   : $31; SelDelimMono    : $0F;
  54.     ProDelimColor   : $1E; ProDelimMono    : $0F;
  55.     SelItemColor    : $3E; SelItemMono     : $70;
  56.     ProItemColor    : $17; ProItemMono     : $07;
  57.     HighItemColor   : $1F; HighItemMono    : $0F;
  58.     AltItemColor    : $1F; AltItemMono     : $0F;
  59.     AltSelItemColor : $3F; AltSelItemMono  : $70;
  60.     FlexAHelpColor  : $1F; FlexAHelpMono   : $0F;
  61.     FlexBHelpColor  : $1F; FlexBHelpMono   : $0F;
  62.     FlexCHelpColor  : $1B; FlexCHelpMono   : $70;
  63.     UnselXrefColor  : $1E; UnselXrefMono   : $09;
  64.     SelXrefColor    : $3F; SelXrefMono     : $70;
  65.     MouseColor      : $4F; MouseMono       : $70
  66.   );
  67.  
  68. {Entry field constants}
  69. const
  70.   idName                 = 0;
  71.   idAddress              = idName + 1;
  72.   idCity                 = idAddress + 1;
  73.   idState                = idCity + 1;
  74.   idZipCode              = idState + 1;
  75.  
  76. type
  77.   UserRecord =
  78.     record
  79.       Name                 : string[30];
  80.       Address              : string[30];
  81.       City                 : string[20];
  82.       State                : string[2];
  83.       ZipCode              : string[10];
  84.     end;
  85. var
  86.   ES     : EntryScreen;
  87.   UR     : UserRecord;
  88.   Status : Word;
  89.   {$IFDEF TestStream}
  90.   L      : Library;
  91.   {$ENDIF}
  92.  
  93. {$IFDEF TestStream}
  94.  
  95. procedure RegisterTypes(var S : IdStream);
  96.   {-Register data types and pointers}
  97. begin
  98.   {register entry screen}
  99.   S.RegisterHier(EntryScreenStream);
  100.  
  101.   {register field types}
  102.   S.RegisterHier(StringFieldStream);
  103.  
  104.   {register user record}
  105.   S.RegisterPointer(1000, @UR);
  106. end;
  107.  
  108. {$ENDIF}
  109.  
  110. function InitEntryScreen : Word;
  111.   {-Initialize entry screen generated by MAKESCRN}
  112. const
  113.   Frame1 = '┌└┐┘──││';
  114.   WinOptions = wBordered+wClear+wUserContents;
  115. begin
  116.   with ES do begin
  117.     if not InitCustom(20, 10, 60, 16, EsColors, WinOptions) then begin
  118.       InitEntryScreen := InitStatus;
  119.       Exit;
  120.     end;
  121.  
  122.     wFrame.SetFrameType(Frame1);
  123.     wFrame.AddShadow(shBR, shSeeThru);
  124.     wFrame.AddHeader(' Entry 1 ', heTC);
  125.     esFieldOptionsOn(efClearFirstChar);
  126.     SetWrapMode(WrapAtEdges);
  127.  
  128.   {idName:}
  129.     AddStringField(
  130.       'Name:', 2, 5,
  131.       CharStr('X', 30), 2, 11, 30,
  132.       1, UR.Name);
  133.  
  134.   {idAddress:}
  135.     AddStringField(
  136.       'Address:', 3, 2,
  137.       CharStr('X', 30), 3, 11, 30,
  138.       2, UR.Address);
  139.  
  140.   {idCity:}
  141.     AddStringField(
  142.       'City:', 4, 5,
  143.       'XXXXXXXXXXXXXXXXXXXX', 4, 11, 20,
  144.       3, UR.City);
  145.  
  146.   {idState:}
  147.     AddStringField(
  148.       'State:', 5, 4,
  149.       'AA', 5, 11, 2,
  150.       4, UR.State);
  151.  
  152.   {idZipCode:}
  153.     AddStringField(
  154.       'Zip:', 6, 6,
  155.       '99999 9999', 6, 11, 10,
  156.       5, UR.ZipCode);
  157.  
  158.     InitEntryScreen := RawError;
  159.   end;
  160. end;
  161.  
  162. {*** sample test code follows ***}
  163.  
  164. begin
  165.   ClrScr;
  166.  
  167.   {$IFDEF UseMouse}
  168.   if MouseInstalled then
  169.     with EsColors do begin
  170.       {activate mouse cursor}
  171.       SoftMouseCursor($0000, (ColorMono(MouseColor, MouseMono) shl 8)+
  172.                              Byte(MouseChar));
  173.       ShowMouse;
  174.       {enable mouse support}
  175.       EntryCommands.cpOptionsOn(cpEnableMouse);
  176.     end;
  177.   {$ENDIF}
  178.  
  179.   {initialize entry screen}
  180.   Status := InitEntryScreen;
  181.   if Status <> 0 then begin
  182.     WriteLn('Error initializing entry screen: ', Status);
  183.     Halt(1);
  184.   end;
  185.  
  186.   {initialize user record}
  187.   FillChar(UR, SizeOf(UR), 0);
  188.  
  189.   {$IFDEF TestStream}
  190.  
  191.   {set user record}
  192.   ES.SetUserRecord(UR, SizeOf(UR));
  193.  
  194.   {does library exist?}
  195.   if ExistFile('ENTRY1.OPL') then begin
  196.     {open library}
  197.     L.Init('ENTRY1.OPL', SOpen, 4096, '');
  198.     if L.GetStatus <> 0 then begin
  199.       WriteLn('Error opening library');
  200.       Halt(1);
  201.     end;
  202.   end
  203.   else begin
  204.     {create library}
  205.     L.Create('ENTRY1.OPL', 4096, '', 15);
  206.     if L.GetStatus <> 0 then begin
  207.       WriteLn('Error creating library');
  208.       Halt(1);
  209.     end;
  210.   end;
  211.  
  212.   {register types and store the entry screen}
  213.   RegisterTypes(L);
  214.   L.PutEntry('ENTRY1', ES);
  215.   if L.GetStatus <> 0 then begin
  216.     WriteLn('Store error');
  217.     Halt(2);
  218.   end;
  219.   L.Done;
  220.   ES.Done;
  221.  
  222.   {reopen library}
  223.   L.Init('ENTRY1.OPL', SOpen, 4096, '');
  224.  
  225.   {register types and load the entry screen}
  226.   RegisterTypes(L);
  227.   L.GetEntry('ENTRY1', ES);
  228.   if L.GetStatus <> 0 then begin
  229.     WriteLn('Load error');
  230.     Halt(3);
  231.   end;
  232.   L.Done;
  233.  
  234.   {$ENDIF}
  235.  
  236.   {test entry screen}
  237.   ES.Process;
  238.   ES.Erase;
  239.  
  240.   {show exit command}
  241.   WriteLn('Exit command = ', ES.GetLastCommand);
  242.   ES.Done;
  243.  
  244.   {$IFDEF UseMouse}
  245.   HideMouse;
  246.   {$ENDIF}
  247. end.
  248.